perm filename PLAY.FAI[M11,LCS]1 blob
sn#400660 filedate 1978-11-30 generic text, type T, neo UTF8
00100 TITLE PLAY; DOROTHY BENDER MEMORIAL TITLE 1969,1975,77(LCS)*******
00200
00300 ;************** LOAD WITH 'DACPLA.FAI' ****** (IT MAY BE ON [SIX,MUS] ) *******
00400
00500 ; ROUTINE TO READ THE OUTPUT FROM THE MUSIC
00600 ; PROGRAM AND CALL THE D-A CONVERTER TO PLAY.
00700 ;
00800 ; NAME OF THE FILE TO BE INPUTTED IS 'TEST.SND',
00900 ; THE FIRST RECORD OF WHICH CONTAINS THE
01000 ; NUMBER OF WORDS OF DATA IN THE ENTIRE DISK FILE.
01100
01200 ENTRY PLAY
01300 A ← 1 ;WORK
01400 B ← 2 ;WORK
01500 T1 ← 4 ; TEMP FOR ADSMAP (JAM)
01600 REP ← 6; ;FOR REPLAY USETI
01700 P ← 17
01800 ↓DSKCH ←1 ;DISK CHANNEL FOR INPUT
01900 ↓ADCHN ←2 ;D-A CHANNEL FOR OUTPUT
02000 ↓SIXCH ←3 ;SIX CHANNEL FOR RUNNING DAC
02100 PDL: BLOCK 40
02200 OPDEF READCH [51B8]
02300 OPDEF MESSAGE[51B8!3B12]
02400
02500 ;;EXTERNAL DACINI,DACPLA,DACWAI,DACREL
02600 ;External integer procedure DACINI(Integer dskCH,sixchn,dacchn,clock,pack,nchns,waitflag(0));
02700 ;External integer procedure DACPLA(Integer stword,nwds,track(0),blk(0));
02800 ;External integer procedure DACWAI;
02900 ;External integer procedure DACREL;
03000
03100 PLAY: 0
03200 BEG: CALLI 0,0 ;RESET I/O DEVICES
03300 MOVE 10,'DSK ' ;DEVICE NAME
03400 MOVE 6,['TEST ']
03500 MOVE 7,['SND ']
03600 MOVE 10,['DSK ']
03700 SETZM DIR+3 ;FOR RESTART
03800 SETZM DEVNAM ;DEVICE NAME
03900 SETZM SAVSPD# ;SAVES SPEED FOR REPLAYS
04000 ;; OUTSTR[ASCIZ/
04100 ;;FILE NAME -- /]
04200 SETO 5, ;FLAG FOR EXTENSIONS
04300 DIREC: SETZM DIR+1
04400 SETZM DIR
04500 FLNM: MOVE 2,[POINT 6,DIR]
04600 JRST LX ;;;; JRST GOT
04700 EXT: MOVE 2,[POINT 6,DIR+1]
04800 SETZ 5,
04900 GOT: INCHWL 1
05000 CAIN 1,15 ; A CR?
05100 JRST GOT
05200 CAIL 1,60 ; CHECKS FOR GOOD CHARS.
05300 CAIN 1,":" ;LOOK FOR DEVICE NAME:
05400 JRST LX
05500 cail 1,"a" ;change lower case to upper
05600 SUBI 1,40
05700 SUBI 1,40
05800 IDPB 1,2
05900 JRST GOT
06000 LX: JUMPE 5,LZ
06100 SKIPN DIR
06200 MOVEM 6,DIR
06300 CAIN 1,56 ; 56='.'
06400 JRST EXT
06500 CAIE 1,":" ;LOOK FOR DEV. NAME
06600 JRST LZ
06700 MOVE 10,DIR ;PUT 'FILE NAME' IN AS DEVICE
06800 JRST DIREC ;NOW GO BACK AND START OVER
06900 LZ: SKIPN DIR+1
07000 MOVEM 7,DIR+1
07100 MESS: MOVEM 10,DEVNAM
07200 MOVEM .+3
07300 MOVE P,[IOWD 40,PDL]
07400 OPEN DSKCH,[17 ;MODE
07500 DEVNAM: 0
07600 0] ;NO BUFFER HEADERS
07700 HALT BEG ;RESTART IF DEVICE IS UNAVAILABLE
07800
07900 ;; MESSAGE [ASCIZ/
08000 ;;TYPE <S> TO CHANGE SPEED. TYPE <Rn> TO REPEAT n TIMES. /]
08100 SETZM REP ; FOR SPEED CHNGS WITH HEADER
08200 MOVEI A,1
08300 DPB A,[POINT 2,DACPAR,35]
08400 JRST SPD
08500 SPEED: MESSAGE [ASCIZ/PEED
08600 0=6.4K 1=12.8 2=25.6 3=51.2 4=102.8 5=204.8 /]
08700 READCH A
08800 CAIN A,15 ; A CR?
08900 JRST LF ; GET THE LF
09000 CAILE A,"5" ;IS IT 1 - 5?
09100 JRST SPEED ; BAD SPEED, TRY AGAIN.
09200 SPD3: DPB A,[POINT 3,DACPAR,26] ;PUT AWAY THE SPEED
09300 JRST SPD
09400 LF: READCH A ;GET THE LF
09500 SPD: MESSAGE [ASCIZ/
09600
09700 PLAY? /]
09800 SETOM REPT# ;FOR MULTIPLE PLAYS WITH Rn
09900 READCH A
10000 CAIN A,"X"
10100 CALLI 12 ;X=EXIT, MUST EXIT BECAUSE CHNS ARE CONFUSED.
10200 CAIE A,"s"
10300 CAIN A,"S"
10400 JRST SPEED
10500 CAIN A,15 ; IS IT A CRLF???
10600 JRST PLA2
10700 CAIn A,"r" ;TYPE Rn TO REPEAT n TIMES, NO PAUSE
10800 jrst rep3
10900 CAIE A,"R" ;TYPE Rn TO REPEAT n TIMES, NO PAUSE
11000 JRST PLA2 ;ELSE GO PLAY SAME AS LAST TIME
11100 REP3: MESSAGE [ASCIZ/EPEAT /]
11200 READCH A ;GET NUM FOLLOWING R.
11300 SUBI A,"0" ;MAKE BIN.
11400 CAILE A,=9 ;IF(A.GT.9)A=1 TRAPS "G" ETC.
11500 MOVEI A,1
11600 MOVNM A,REPT ;REPEATS UP TO 9 TIMES.
11700 MOVE A,SAVSPD ;GET BACK SPEED.
11800 PLA2: SETZM DIR+3
11900 LOOKUP DSKCH,DIR
12000
12100 JRST [MESSAGE[ASCIZ/
12200 *** MUSIC FILE NOT FOUND/]
12300 JRA 16,16] ;RETURN IF FILE IS MISSING
12400 ;;; CALLI 12] ;EXIT IF FILE IS MISSING
12500
12600 XOPEN: OPEN ADCHN,[1B27+000 ;MODE
12700 'DAC ' ;DEVICE NAME
12800 0] ;NO BUFFER HEADERS
12900 SKIPA
13000 JRST GOTCHA ;GO AHEAD
13100 MESSAGE [ASCIZ/
13200 WAITING FOR DAC------ /]
13300 OPEN ADCHN,[1B26+000 ;WE'LL WAIT FOR IT
13400 'DAC '
13500 0]
13600 0 ;NO FAILURE POSSIBLE?????
13700 GOTCHA: PUSH P,[DSKCH]
13800 PUSH P,[SIXCH]
13900 PUSH P,[ADCHN]
14000 LDB B,[POINT 3,DACPAR,26] ;PUT AWAY THE SPEED
14100 PUSH P,B
14200 LDB B,[POINT 2,DACPAR,29] ;12 OR 18 BIT
14300 PUSH P,B
14400 LDB B,[POINT 2,DACPAR,35]
14500 PUSH P,B
14600 PUSH P,[0] ; INTERROGATE USER AND WAIT FOR IT
14700 PUSHJ P,DACINI
14800 SPWAR: LOCK A, ;SPWAR:
14900
15000 MESSAGE [ASCIZ/ GO? /]
15100 READCH A
15200 CAIN A,15
15300 READCH A ;FOR CRLF
15400 ; READS TO FIND (AND IGNORE) HEADER.(1ST REC.)
15500 DOIT: SKIPE REP ;SKIP FIRST TIME
15600 JRST REPLA ;OMIT HEADER ON REPLAYS
15700 MOVEI REP,1 ;FOR REPLAY
15800 INPUT DSKCH,HEADER
15900 MOVEI A,BUF1-1
16000 MOVE B,1(A)
16100 CAME B,[525252525252] ; LOOKS FOR MAGIC NUMBER.
16200 JRST REPLA
16300 PUSH P,[DSKCH]
16400 PUSH P,[SIXCH]
16500 PUSH P,[ADCHN]
16600 HLRZ B,2(A) ;GET SPEED FROM LEFT HALF OF WD 2
16700 JUMPG B,SPOK
16800 MOVE B,2(A) ;FIND SRATE NUM FOR SPEED
16900 IDIVI B,=10000 ;RIGHT FOR SPEED 0,1,2 ONLY
17000 SPOK: CAIL B,3 ;LOOK FOR SPEED 3
17100 MOVEI B,3 ;WON'T GET 4 OR 5
17200 MOVEM B,SAVSPD
17300 MOVE 10,B
17400 OUTSTR[ASCIZ/
17500
17600 SPEED=/]
17700 SOJL 10,SP0
17800 SKIPE 10
17900 JRST .+3
18000 OUTSTR[ASCIZ/1(12.8k)/]
18100 JRST SPDOK
18200 SOJL 10,SP3
18300 OUTSTR[ASCIZ/2(25.6k)/]
18400 JRST SPDOK
18500 SP0: OUTSTR[ASCIZ/0(6.4k)/]
18600 SKIPA
18700 SP3: OUTSTR[ASCIZ/3(51.2k)/]
18800
18900 SPDOK: DPB B,[POINT 3,DACPAR,26] ;PUT AWAY THE SPEED
19000 PUSH P,B
19100 HRRZ B,3(A) ;GET BITS FROM RIGHT HALF OF WD 3
19200 DPB B,[POINT 2,DACPAR,29] ;12 OR 18 BIT
19300 PUSH P,B
19400 MOVE B,4(A) ;GET NCHNS FROM WD 4
19500 OUTSTR[ASCIZ/ -- NCHNS=/]
19600 MOVE 10,B
19700 SOJE 10,NCH1
19800 SOJE 10,NCH2
19900 OUTSTR[ASCIZ/4
20000 /]
20100 JRST OK2
20200 NCH1: OUTSTR[ASCIZ/1
20300 /]
20400 SKIPA
20500 NCH2: OUTSTR[ASCIZ/2
20600 /]
20700 OK2: DPB B,[POINT 2,DACPAR,35]
20800 PUSH P,B
20900 PUSH P,[0] ; INTERROGATE USER IF DAC NOT AVAILABLE
21000 PUSHJ P,DACINI ; INITIALIZE THE DAC, SET PARAMETERS
21100 MOVEI REP,2 ;FOR REPLAY
21200 REPLA: USETI DSKCH,(REP) ;REP=1 IF NO HEADER, =2 WITH HEADER.
21300 LNTH: movs a,DIR+3 ;get length of file.
21400 CAIN REP,2 ;WAS THERE A HEADER?
21500 ADDI A,200 ;YES, SUBTRACT IT FROM WDCNT.
21600 movnm a,nwd
21700 ;-----------------------------------------------------
21800
21900 ;BEGIN MAIN BODY OF PROGRAM
22000
22100 MOVE T1,[647001,,0] ;FOR AUDIO CH.1 NOV. 11, 1977 LCS
22200 ;;; MOVE T1,[647003,,0] ;FOR AUDIO CH. 3
22300 ADSMAP T1, ; SET AUDIO SWITCH TEMPORARILY TO DAC (JAM 7/24/75)
22400 ; THE OPTIONS WE ASKED FOR ARE TEMPORARY, WAIT FOR
22500 ; PAGE TO FINISH, DON'T INTERRUPT WITH MORE PAGES,
22600 ; DELAY BEEPS TO END OF XFR.
22700 OUTSTR [ASCIZ /
22800 TO DAC . . ./]
22900 PUSH P,REP ; SAVE OVER CALL
23000 SETZ B,
23100 CAIN REP,2
23200 MOVEI B,200
23300 PUSH P,B
23400 PUSH P,NWD
23500 PUSH P,[0]
23600 PUSH P,[0]
23700 PUSHJ P,DACPLA
23800 POP P,REP ; GET REP BACK
23900
24000 DONE: AOSGE REPT ;UPDATE REPT
24100 JRST REPLA ;WE PLAY AGAIN IF REPT .LT.0
24200 PUSHJ P,DACWAI
24300 PUSHJ P,DACREL
24400 close dskCH, ;END OF PROGRAM.
24500 releas adchn,
24600 OUTSTR [ASCIZ / DONE!
24700 /]
24800 SETO T1,
24900 ADSMAP T1, ; RESET AUDIO SWITCH CONNECTION TO PERMANENT (JAM 7/24/75)
25000 UNLOCK
25100 jrst SPD
25200
25300
25400 ; STORAGE:
25500
25600 NWD: 0 ;FOR NUMBER OF WORDS OF INPUT.
25700
25800 DIR: 0 ;NAME
25900 0 ;EXTENSION
26000 0 ;INFORMATION ON FILE
26100 0 ;PROJECT PROG#
26200 HEADER: IOWD =128,BUF1
26300 0
26400 BUF1: BLOCK =128
26500 DACPAR: 1001 ;SPEED 0=6.4K, 1=12.8, 2=25.6, 3=51.2, 4=102.4, 5=
26600 0
26700 0
00100 ;entry DACPLA
00200 ;;title DACPLA
00300 ;;internal DACINI,DACPLA,DACWAI,DACREL
00400 external DSK6RD,DSK6WR,MESINI
00500 .library JAMLIB.REL[SUB,SYS]
00600 comment ⊗
00700
00800 External integer procedure DACINI(Integer dskchn,sixchn,dacchn,clock,pack,nchns,waitflag(0));
00900 External integer procedure DACPLA(Integer stword,nwds,track(0),blk(0));
01000 External integer procedure DACWAI;
01100 External integer procedure DACREL;
01200
01300 DACINI
01400
01500 Must have disk open on channel DSKCHN. It will open the SIX and the DAC. Afterwards
01600 it will set the DAC parameters to CLOCK, PACK, and NCHNS. It will then claim
01700 buffers on the 6 and lock your KL10 job into core. Returns zero or -1 on success:
01800 -1 means it had to wait for the DAC. Returns error 1 for user didn't want to
01900 wait for the DAC and 2 if there was not enough core on the SIX.
02000 The WAITFLAG determines whether DACINI will query the user as to whether he wants
02100 to wait for the DAC. 0 means interrogate user and wait if he asks, 1 means always
02200 wait (without asking) and -1 means never wait, never ask.
02300 Disk must be opened in mode 17 (dump mode). Can be disk, new or old format UDP.
02400 Track and BLK in DACPLA are irrelevant except for old format UDP.
02500 (will get illegal UUO if disk not opened in mode 17).
02600
02700 CLOCK is actually the clock code, not the clock rate. This is 0 for 6.4 Kc,
02800 1 for 12.8 Kc, 2 for 25.6 Kc, 3 for 51.2 Kc, and 4 for 102.4 Kc. This is the
02900 clock rate per channel (not the overall clock rate). Pack should be 0 for
03000 12-bit or 1 for 18-bit.
03100
03200 DACPLA
03300
03400 Queues up the sound in the dsk channel from word number STWORD for a total
03500 of NWDS words. Transfer may still be running when this routine exits.
03600
03700 DACWAI
03800
03900 This waits for any transfers which were running to be finished. After
04000 this call, the DAC will be idle.
04100
04200 DACREL
04300
04400 This releases the DAC, stops any transfer which might be running, and
04500 releases the buffers on the six. It will release the SIX and the DAC.
04600
04700 ⊗
00100 ; Accumulators, temp storage
00200
00300 ↓ac1←4
00400 ↓ac2←5
00500 ↓ac3←6
00600 ↓ac4←7
00700 ↓ac5←10
00800 ↓ac6←11
00900 ↓ac7←13
01000 ↓ac8←14
01100 ↓ac9←15
01200 ↓p←17
01300
01400 .insert MESDEF[SIX,MUS] ;WHAT DOES THIS DO??
01500
01600 adr: block 2 ; For IOWDS and stuff
01700 data: block 3 ; For messages
01800 dacchn: 0 ; Channel number for DAC
01900 sixchn: 0 ; " for SIX
02000 dskchn: 0 ; " for DSK
02100
02200
02300 ; Message codes going to DAC
02400
02500 MSPAR←←1010 ; SET PARAMETERS. TAKES 9-BIT DATUM
02600 MSTBUF←←1011 ; START BUFFER. TAKES WCMA AS DATUM.
02700 MSTOP←←1012 ; DROP EVERYTHING
02800 MQBUF←←1013 ; QUEUE BUFFER BUT DON'T START IT
02900 MFSTB←←1015 ; FIRST BUFFER COMING
03000
03100 ; Message codes coming from DAC
03200
03300 MBDONE←←1020 ; BUFFER DONE.
03400 MHUNG←←1021 ; DEVICE IS HUNG.
03500 MDMISS←←1022 ; HARDWARE DATA MISSED SEEN
03600 MBMISS←←1023 ; BUFFER MISSED (RAN OFF END WITH NO WCMA READY)
03700 MBOOB←←1025 ; BUFFER OUT OF BOUNDS
03800
03900 DACDEV←←2 ; DIGITAL-ANALOG CONVERTER DEVICE NUMBER
04000
04100 ; = SPEED*1000+PACK*100+NCHANS
04200 ; NCHANS = 1 FOR MONO (2-BIT NUMBER)
04300 ; = 2 FOR STEREO
04400 ; = 0,3 FOR QUAD
04500 ; PACK = 0,3 FOR 12 BIT (2-BIT NUMBER)
04600 ; = 1 FOR 16 BIT (HALFWORD MODE)
04700 ; = 2 FOR FLOATING PT. INCREMENTAL
04800 ; SPEED = 0 FOR 6.4 KC (3-BIT NUMBER)
04900 ; = 1 FOR 12.8 KC
05000 ; = 2 FOR 25.6 KC
05100 ; = 3 FOR 51.2 KC
05200 ; = 4 FOR 102.4 KC
05300 ; = 5 FOR 204.8 KC
05400
05500 ; Other storage . . .
05600
05700 oldfmt: 0 ; 0 for New fmt, ≠0 for old fmt udp
05800 wcmas:
05900 wcma1: 0 ; WCMA for buffer 1
06000 wcma2: 0 ; for buffer 2
06100 wcma3: 0 ; Set to zero if not needed
06200 nxtwc: 0 ; 0, 1, or 2, for next buffer to fill
06300 nq: 0 ; Number of xfrs in queue now (0, 1, 2, or 3)
06400
06500 trklen←←=18*=128 ; Length of track for new fmt UDP or DSK
06600 otrklen←←40+trklen ; Same for old fmt UDP
06700 ↓ntrks←←6 ; Number of tracks per buffer
06800 ;↓ntrks←←10 ; Number of tracks for SIXSYS without DDT
06900 waited: 0 ; Set to -1 if we waited for DAC
00100 ; Error codes
00200
00300 enodac←←1 ; User doesn't want to wait for DAC
00400 enocor←←2 ; Not enuf core on PDP-6
00500 didwait←←-1 ; Did have to wait for DAC
00600
00700 ; DACINI
00800 ;External integer procedure DACINI(Integer dskchn,sixchn,dacchn,clock,pack,nchns,waitflag(0));
00900
01000 DACINI: begin DACINI
01100
01200 watloc←←-1
01300 ncloc←←-2
01400 pakloc←←-3
01500 clkloc←←-4
01600 dacloc←←-5
01700 sixloc←←-6
01800 dskloc←←-7
01900 pd←←10
02000
02100 nowait←←400
02200 wait←←1000
02300
02400 setzm waited
02500 move ac1,dskloc(p)
02600 movem ac1,dskchn
02700 dpb ac1,[point 4,dskc1,12]
02800
02900 devchr ac1, ; if 100000 bit in LH is on, and
03000 ; 200000 bit is off, is old-style udp
03100 setom oldfmt
03200 tlne ac1,100000
03300 tlne ac1,200000
03400 setzm oldfmt
03500
03600 move ac1,sixloc(p)
03700 movem ac1,sixchn
03800 dpb ac1,[point 4,sixc1,12]
03900 dpb ac1,[point 4,sixc2,12]
04000 dpb ac1,[point 4,sixc3,12]
04100 dpb ac1,[point 4,sixc4,12]
04200 dpb ac1,[point 4,sixc5,12]
04300 dpb ac1,[point 4,sixc6,12]
04400 dpb ac1,[point 4,sixc7,12]
04500 dpb ac1,[point 4,sixc8,12]
04600 dpb ac1,[point 4,sixc9,12]
04700 dpb ac1,[point 4,sixc10,12]
04800 dpb ac1,[point 4,sixc11,12]
04900 dpb ac1,[point 4,sixc12,12]
05000 dpb ac1,[point 4,sixc13,12]
05100 dpb ac1,[point 4,sixc14,12]
05200 push p,ac1
05300 pushj p,mesini
05400
05500 move ac1,dacloc(p)
05600 movem ac1,dacchn
05700 dpb ac1,[point 4,dacc1,12]
05800 dpb ac1,[point 4,dacc2,12]
05900 dpb ac1,[point 4,dacc3,12]
06000 dpb ac1,[point 4,dacc4,12]
06100
06200 dacc1: init 0,nowait
06300 sixbit /DAC/
06400 0
06500 jrst [move ac1,watloc(p)
06600 jumpl ac1,nodacx
06700 jumpg ac1,dacc2
06800 outstr [asciz /
06900 DAC is busy. Will you wait? /]
07000 inchwl ac1
07100 pushj p,rdlf
07200 caie ac1,"y"
07300 cain ac1,"Y"
07400 jrst dacc2
07500 nodacx: movei 1,enodac ; Give "no DAC" error message
07600 jrst xit]
07700 sixc1: init 0,17
07800 sixbit /SIX/
07900 0
08000 jrst 4,.
08100 ; = SPEED*1000+PACK*100+NCHANS
08200 move ac1,[mspar,,dacdev]
08300 movem ac1,data
08400 movsi ac1,1
08500 movem ac1,data+1
08600 move ac1,clkloc(p)
08700 lsh ac1,=3
08800 or ac1,pakloc(p)
08900 lsh ac1,=6
09000 or ac1,ncloc(p)
09100 movem ac1,data+2
09200 move ac1,[iowd 3,data]
09300 movem ac1,adr
09400 setzm adr+1
09500 sixc2: output 0,adr
09600
09700 movei ac1,ntrks*trklen
09800 skipe oldfmt
09900 movei ac1,ntrks*otrklen ; Get 4 tracks per buffer
10000 movem ac1,data+2
10100 movsi ac1,mgbuf
10200 hllm ac1,data
10300 sixc3: output 0,adr
10400 sixc4: output 0,adr
10500 sixc5: output 0,adr ; Ask for 3 buffers of identical size.
10600 movei ac2,2
10700 sixc6: input 0,adr ; Wait for message to come back
10800 hlrz ac1,data
10900 trne ac1,fncomp!fdmissed
11000 jrst [outstr [asciz /DACINI - Incomplete message from PDP-6
11100 /]
11200 jrst mbtest]
11300 mbtest: caie ac1,f6to10!mgbuf ; Ignore everything but buffer reply
11400 jrst sixc6
11500 skipl ac1,data+2
11600 jrst nocore ; Hmmm. No core?
11700 movem ac1,wcmas(ac2)
11800 sojge ac2,sixc6
11900 setzm nq ; Clear number of buffers in queue
12000 setzm nxtwc
12100
12200 setz 1,
12300 skipe waited
12400 move 1,[didwait] ; Give -1 return for waited
12500 xit: adjsp p,-pd
12600 jrst @pd(p)
12700
12800 dacc2: init 0,wait
12900 sixbit /DAC/
13000 0
13100 jrst 4,.
13200 setom waited
13300 jrst sixc1
13400
13500 nocore: movsi ac1,mdblast ; Forget everything we ever know about device
13600 hllm ac1,data
13700 move ac1,[iowd 1,data]
13800 movem ac1,data+1
13900 sixc7: output 0,adr
14000 movei 1,enocore
14100 dacc3: release 0, ; Release dummy DAC device
14200 setzm wcma1
14300 setzm wcma2
14400 setzm wcma3
14500 jrst xit
14600
14700 rdlf: cain ac1,12
14800 popj p,
14900 rdlf1: inchwl ac9
15000 cain ac9,175
15100 jrst isalt
15200 caie ac9,12
15300 jrst rdlf1
15400 popj p,
15500
15600 isalt: outstr [asciz /
15700 /]
15800 popj p,
15900
16000 bend DACINI
00100 ; DACPLA
00200 ;External integer procedure DACPLA(Integer stword,nwds,track(0),blk(0));
00300
00400 ; Uses . . .
00500
00600 ;External procedure DSK6RD(integer dchan,nwds,p3addr,track(0),blk(0));
00700 ;External procedure DSK6WR(integer dchan,nwds,p3addr,track(0),blk(0));
00800
00900 ;DAC may be running when we enter.
01000
01100 DACPLA: begin DACPLA
01200
01300 integer offset ; Number of words in first buffer to be ignored
01400 integer track
01500 integer block ; For old mode
01600 integer nwltt ; Number of words left this track
01700 integer ndwfb ; Number of words in first buffer (from disk) total
01800 integer nwfb ; Number of data words in first buffer (for DAC)
01900
02000 blkloc←←-1
02100 trkloc←←-2
02200 nwdloc←←-3
02300 stwloc←←-4
02400 pd←←5
02500
02600 setz 1,
02700 skipg nwdloc(p) ; Anybody home?
02800 jrst xit ; No, leave now
02900 skipe wcma1
03000 skipn wcma2
03100 jrst [movei 1,enocore
03200 jrst xit]
03300 skipn wcma3
03400 jrst [movei 1,enocore
03500 jrst xit]
03600
03700 skipe oldfmt
03800 jrst isold
03900 move ac1,stwloc(p)
04000 move ac2,ac1
04100 andi ac2,177
04200 movem ac2,offset
04300 lsh ac1,-7
04400 addi ac1,1
04500 ↑dskc1: useti 0,(ac1)
04600
04700 move ac1,stwloc(p)
04800 idivi ac1,trklen
04900 movn ac2,ac2
05000 addi ac2,trklen
05100 movem ac2,nwltt
05200
05300 addi ac2,<ntrks-1>*trklen
05400 movem ac2,nwfb
05500 jrst allgo
05600
05700 isold: move ac1,trkloc(p)
05800 imuli ac1,otrklen
05900 move ac2,blkloc(p)
06000 caige ac2,1
06100 jrst nocorr
06200 addi ac1,40
06300 subi ac2,1
06400 lsh ac2,7
06500 addi ac1,(ac2) ; Convert to word number on UDP
06600 nocorr: add ac1,stwloc(p)
06700 idivi ac1,otrklen ; And back to track-block
06800 movem ac1,track
06900 movni ac3,(ac2) ; Pick up number of words used this track
07000 addi ac3,otrklen
07100 movem ac3,nwltt ; Set number words left this track
07200 addi ac3,<ntrks-1>*otrklen
07300 movem ac3,nwfb
07400 caige ac2,40
07500 jrst [setzm block
07600 jrst setoff]
07700 subi ac2,40
07800 move ac1,ac2
07900 andi ac2,177
08000 lsh ac1,-7
08100 addi ac1,1
08200 movem ac1,block
08300 setoff: movem ac2,offset
08400
08500 allgo: push p,dskchn
08600 move ac1,nwfb
08700 camle ac1,nwdloc-1(p)
08800 move ac1,nwdloc-1(p) ; Don't do any more than we have to!
08900 movem ac1,ndwfb
09000 add ac1,offset ; Make sure we get all of first record
09100 push p,ac1
09200 move ac2,nxtwc
09300 hrrz ac1,wcmas(ac2)
09400 push p,ac1
09500 push p,track
09600 push p,block
09700 move ac1,nq ; How many are queued?
09800 cail ac1,3 ; If more than 3, must wait
09900 pushj p,wait1 ; Wait until that first buffer is free
10000 pushj p,dsk6rd ; Fill it
10100
10200 move ac2,nxtwc ; Pick up buffer number (0, 1, or 2)
10300 movn ac1,ndwfb ; This has been truncated to length of file
10400 addm ac1,nwdloc(p) ; Note that many more words gone by
10500 movs ac1,ac1 ; Make up WCMA for transfer
10600 hrr ac1,wcmas(ac2) ; Put address of buffer on 6 in RH
10700 add ac1,offset ; Offset for partial first buffer (if any)
10800 movem ac1,data+2
10900 move ac1,[mstbuf,,dacdev]
11000 movem ac1,data
11100 movsi ac1,1
11200 movem ac1,data+1
11300 move ac1,[iowd 3,data]
11400 movem ac1,adr
11500 ↑sixc8: output 0,adr
11600 aos nq ; Note one more in the queue
11700 sosge ac1,nxtwc
11800 movei ac1,2
11900 movem ac1,nxtwc
12000 skipg nwdloc(p)
12100 jrst alldone
12200
12300 setzm offset
12400 movei ac1,ntrks*trklen
12500 skipe oldfmt
12600 movei ac1,ntrks*otrklen
12700 movem ac1,nwfb
12800
12900 movei ac1,ntrks
13000 addm ac1,track
13100 setzm block
13200 jrst allgo
13300
13400 alldone:setz 1,
13500 xit: adjsp p,-pd
13600 jrst @pd(p)
13700
13800 bend DACPLA
00100 ; WAIT1 - Wait for a buffer done message
00200
00300 WAIT1: move ac1,[iowd 3,data]
00400 movem ac1,adr
00500 sixc9: input 0,adr
00600 hlrz ac1,data
00700 trne ac1,fncomp!fdmissed
00800 jrst [outstr [asciz /DACPLA - incomlete message from 6!
00900 /]
01000 jrst wattst]
01100 wattst: andi ac1,7777
01200 cain ac1,mhung
01300 jrst [outstr [asciz /DACPLA - DAC is HUNG!
01400 /]
01500 jrst gotit] ; Hung message takes place of done message
01600 cain ac1,mboob
01700 jrst [outstr [asciz /DACPLA - buffer out of bounds?!?!!?
01800 /]
01900 jrst gotit] ; this message also takes place of done message
02000 cain ac1,mdmiss
02100 jrst [outstr [asciz /DACPLA - DAC Data missed!
02200 /]
02300 jrst sixc9]
02400 cain ac1,mbmiss
02500 jrst [outstr [asciz /DACPLA - DAC buffer missed!
02600 /]
02700 jrst sixc9]
02800 caie ac1,mbdone
02900 jrst sixc9
03000 gotit: sosl nq ; Note one less in queue
03100 cpopj: popj p,
03200 outstr [asciz /DACPLA - Buffer queue underflow
03300 /]
03400 jrst 4,cpopj
03500
03600 ; DACWAI - Wait for all xfrs to finish
03700
03800 DACWAI: skipg nq
03900 jrst sfstbm
04000 pushj p,wait1
04100 jrst dacwai
04200
04300 sfstbm: move ac1,[fnowds!mfstb,,dacdev]
04400 movem ac1,data
04500 move ac1,[iowd 1,data]
04600 movem ac1,adr
04700 sixc14: output 0,adr ; Clear "buffers finished" count
04800 popj p,
00100 ; DACREL - release the device
00200
00300 DACREL: move ac1,[iowd 1,data]
00400 movem ac1,adr
00500 move ac1,[fnowds!mdblast,,dacdev]
00600 movem ac1,data
00700 sixc10: output 0,adr
00800 move ac1,[iowd 3,data]
00900 movem ac1,adr
01000 move ac1,wcma1
01100 movem ac1,data+2
01200 move ac1,[mgivb,,dacdev]
01300 movem ac1,data
01400 movsi ac1,1
01500 movem ac1,data+1
01600 sixc11: output 0,adr
01700 move ac1,wcma2
01800 movem ac1,data+2
01900 sixc12: output 0,adr
02000 move ac1,wcma3
02100 movem ac1,data+2
02200 sixc13: output 0,adr
02300 setzm wcma1
02400 setzm wcma2
02500 setzm wcma3
02600 dacc4: release 0,
02700 popj p,
02800 END